home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 026-050 / scopedisk28 / pipeworx / pipeworks < prev   
Encoding:
Text File  |  1995-03-19  |  10.0 KB  |  397 lines
  1. REM **** By Steve Sibley
  2. REM **** this program incorporates Carolyn Scheppner's program, ~ LOAD ACBM ~
  3. SCREEN 2,320,200,5,1:WINDOW 2,"",,16,2
  4. ON BREAK GOSUB dun2: BREAK ON
  5. PALETTE 0,0,0,.2:PALETTE 1,0,0,.2:PALETTE 2,0,.6,.6:PALETTE 3,0,.6,.6
  6. CLS:COLOR 3,1:WIDTH 39
  7. CLEAR:DEFINT a-Z
  8. DIM TIM(255),N#(60),TIM1(255)
  9. L#=LOG(27.5#)/LOG(2#)
  10. FOR x=0 TO 60:N#(x) = 2^(L# + x/12):NEXT x
  11. FOR I=0 TO 127 STEP 2:TIM(C)=I:C=C+1:NEXT I:C=100
  12. FOR I=126 TO -127 STEP-2:TIM(C)=I:C=C+1:NEXT I:C=0
  13. FOR I=0 TO 127 STEP 2:TIM1(C)=I:C=C+3:NEXT I:C=17
  14. FOR I=126 TO -127 STEP-2:TIM1(C)=I:C=C+1:NEXT I
  15.  
  16. WAVE 0,TIM:WAVE 1,TIM1
  17. ERASE TIM1:ERASE TIM
  18. PRINT " PIPEWORKS - By Steve Sibley"
  19. PRINT " Ever wonder how JUMPDISK gets put"
  20. PRINT " together? It's quite simple."
  21. PRINT " A blank formatted disk is put"
  22. PRINT " into a network of data-filled"
  23. PRINT " brass pipes. As the disk moves"
  24. PRINT " through these pipes, it consumes "
  25. PRINT " tracks of data. When the disk has"
  26. PRINT " completed its journey, a new issue"
  27. PRINT " of JUMPDISK is ready to go."
  28. PRINT " To illustrate this amazing process,"
  29. PRINT " a replica of the system follows."
  30. PRINT " By using the arrow keys, you can"
  31. PRINT " move the disk through the Pipeworks"
  32. PRINT " and see for yourself how it's done."
  33. PRINT " A point is added in the upper left"
  34. PRINT " corner at each intersection. Score"
  35. PRINT " of less than 65 is possible."
  36. PRINT " Remember: It CAN by solved!" 
  37. PRINT " Patience please, while the plumber"
  38. PRINT " stops a small data leak."
  39. LOCATE 12,1:D!=3.6
  40.  
  41. 1 CT=0:SOUND WAIT
  42.  
  43. LOOP:
  44. READ a,B,C,D
  45. IF a=60 AND FIN=1 THEN GOTO LOOP
  46. IF a=1 AND FIN=1 THEN GOTO dun
  47. IF D=11 AND T=4 THEN D!=42:a=23=B=11:C=23 
  48. IF a=60 AND FIN=0 THEN
  49.    SOUND RESUME
  50.    T=T+1
  51.    IF T=1 OR T=3 OR T=4 THEN RESTORE SONG
  52.    GOTO 1
  53. END IF
  54. IF a=0 OR a=60 THEN V1=0 ELSE V1=200
  55. IF B=0 OR B=60 THEN V2=0 ELSE V2=200
  56. IF C=0 OR C=60 THEN V3=0 ELSE V3=250
  57. IF D=0 OR D=60 THEN V4=0 ELSE V4=140
  58. a=N#(a):B=N#(B):C=N#(C):D=N#(D)
  59.   
  60. PL:
  61. SOUND a,D!,V1,0:SOUND B,D!,V2,1:SOUND C,D!,V3,2:SOUND D,D!,V4,3:CT=CT+1
  62. IF D!=42 THEN SOUND RESUME:GOSUB CLICK:CLS:GOTO Main
  63. IF CT=4 THEN SOUND RESUME:CT=0:SOUND WAIT
  64. GOTO LOOP                                                 
  65.  
  66. CLICK:
  67. SOUND 110,3,180,0:SOUND 55,2,180,3
  68. LINE(220,173)-(307,199),2,bf
  69. COLOR 1,2:LOCATE 23,29:PRINT"CLICK HERE";
  70. LOCATE 24,29:PRINT"TO START";
  71. 60  M=MOUSE(0):IF M=0 OR  M=-1 OR M=-2 OR M=3 THEN GOTO 60
  72. M1=MOUSE(1):M2=MOUSE(2):IF POINT(M1,M2)=1 OR POINT(M1,M2)=2 THEN COLOR 3,1:RETURN
  73. GOTO 60
  74.  
  75. SONG:
  76. DATA 0,24,0,16,32,27,32,20,37,41,37,25,30,34,30,18
  77. DATA 37,41,37,13,37,41,37,25,0,28,0,24,0,27,0,23
  78. DATA 35,39,35,23,37,41,37,25,31,35,31,19,31,35,31,19
  79. DATA 31,35,31,19,31,19,31,24,31,35,31,19,30,34,30,18
  80. DATA 37,41,37,13,37,41,37,25,0,28,0,24,0,27,0,23
  81. DATA 42,46,42,18,40,44,40,28,37,41,37,25,35,30,35,23
  82. DATA 33,37,33,21,30,34,30,18,35,39,35,27,35,27,35,23
  83. DATA 35,39,35,27,35,27,35,23,35,39,35,27,35,27,35,11
  84. DATA 60,60,60,60
  85.  
  86. BRIDGE:
  87. DATA 0,24,0,16,32,20,32,20,37,41,37,25,30,34,30,18
  88. DATA 42,46,42,30,42,46,42,25,42,37,42,30,43,47,43,31
  89. DATA 43,37,43,31,43,47,43,35,43,55,43,31,43,50,43,37
  90. DATA 40,52,40,28,40,44,40,33,45,49,45,37,45,45,45,33
  91. DATA 45,49,45,33,45,57,45,21,45,52,45,25,45,49,45,33
  92. DATA 42,46,42,30,42,46,42,25,42,37,42,30,43,47,43,31
  93. DATA 43,37,43,31,43,47,43,35,43,55,43,31,43,50,43,37
  94. DATA 35,39,35,23,38,42,38,26,31,35,31,19,36,40,36,24
  95. DATA 60,60,60,60
  96.  
  97. TAG:
  98. DATA 35,39,35,23,38,42,38,26,31,35,31,19,36,40,36,24
  99. DATA 35,39,35,23,38,42,38,26,31,35,31,19,36,40,36,24
  100. DATA 35,39,35,23,38,42,38,26,31,35,31,19,30,34,30,18
  101. DATA 1,1,1,1
  102.  
  103. REM -  by Carolyn Scheppner  CBM  04/86
  104. Main:
  105. LOCATE 8,9:PRINT"Finishing repair work...
  106. DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
  107. DECLARE FUNCTION xOpen&  LIBRARY
  108. DECLARE FUNCTION xRead&  LIBRARY
  109. DECLARE FUNCTION xWrite& LIBRARY
  110. DECLARE FUNCTION AllocMem&() LIBRARY
  111.  
  112. LIBRARY "dos.library"
  113. LIBRARY "exec.library"
  114. LIBRARY "graphics.library"
  115.  
  116. ACBMname$="maze"
  117. loadError$ = ""
  118. GOSUB LoadACBM
  119.  
  120. OPEN "d.bob" FOR INPUT AS 1:OBJECT.SHAPE 1,INPUT$(LOF(1),1):CLOSE 1
  121. OBJECT.X 1,14
  122. OBJECT.Y 1,20
  123. OBJECT.ON 1:L1=14:L2=20:COLOR 8,0
  124.  
  125. PLAY:
  126. a$=INKEY$
  127. IF a$=CHR$(28) THEN D=1
  128. IF a$=CHR$(29) THEN D=2
  129. IF a$=CHR$(30) THEN D=3
  130. IF a$=CHR$(31) THEN D=4
  131. IF D=0 THEN GOTO PLAY
  132. IF D=1 THEN
  133.  IF POINT(L1,L2-1)=4 THEN L2=L2-1
  134.  IF POINT(L1,L2-1)=6 THEN L2=L2-1:D=0
  135.  IF POINT(L1,L2-1)=7 THEN GOTO BEHIND
  136. ELSEIF D=2 THEN
  137.  IF POINT(L1,L2+3)=4 THEN L2=L2+1
  138.  IF POINT(L1,L2+3)=6 THEN L2=L2+3:D=0
  139.  IF POINT(L1,L2+3)=7 THEN GOTO BEHIND
  140.  IF POINT(L1,L2+3)=8 THEN GOTO fini
  141. ELSEIF D=3 THEN
  142.  IF POINT(L1+3,L2)=5 THEN L1=L1+1
  143.  IF POINT(L1+3,L2)=6 THEN L1=L1+3:D=0
  144.  IF POINT(L1+3,L2)=7 THEN GOTO BEHIND
  145. ELSEIF D=4 THEN
  146.  IF POINT(L1-1,L2)=5 THEN L1=L1-1
  147.  IF POINT(L1-1,L2)=6 THEN L1=L1-1:D=0
  148.  IF POINT(L1-1,L2)=7 THEN GOTO BEHIND
  149. END IF
  150.  
  151. MOVE:
  152. OBJECT.X 1,L1:OBJECT.Y 1,L2
  153. IF D=0 THEN SOUND 100,1,150,0:SOUND 200,1,150,1:SC=SC+1:LOCATE 1,1:PRINT SC;
  154. GOTO PLAY
  155.  
  156. BEHIND:
  157. IF D=1 THEN
  158. L2=L2-1
  159. 10 IF POINT(L1,L2-1)<>4 THEN L2=L2-1:GOTO 10
  160. ELSEIF D=2 THEN
  161. L2=L2+3
  162. 20 IF POINT(L1,L2+1)<>4 THEN L2=L2+1:GOTO 20
  163. ELSEIF D=3 THEN
  164. L1=L1+3
  165. 30 IF POINT(L1+1,L2)<>5 THEN L1=L1+1:GOTO 30
  166. ELSEIF D=4 THEN
  167. L1=L1-1
  168. 40 IF POINT(L1-1,L2)<>5 THEN L1=L1-1:GOTO 40
  169. END IF
  170. GOTO MOVE
  171.  
  172. LoadACBM:
  173. REM - Requires the following variables
  174. REM - to have been initialized:
  175. REM -    ACBMname$ (ACBM filespec)
  176.  
  177. REM - init variables
  178. f$ = ACBMname$
  179. fHandle& = 0
  180. mybuf& = 0
  181. foundBMHD = 0
  182. foundCMAP = 0
  183. foundCAMG = 0
  184. foundCCRT = 0
  185. foundABIT = 0
  186.  
  187. REM - From include/libraries/dos.h
  188. REM - MODE_NEWFILE = 1006 
  189. REM - MODE_OLDFILE = 1005
  190.  
  191. filename$ = f$ + CHR$(0)
  192. fHandle& = xOpen&(SADD(filename$),1005)
  193. IF fHandle& = 0 THEN
  194.    loadError$ = "Can't open/find pic file"
  195.    GOTO Lcleanup
  196. END IF
  197.  
  198.  
  199. REM - Alloc ram for work buffers
  200. ClearPublic& = 65537&
  201. mybufsize& = 360
  202. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  203. IF mybuf& = 0 THEN
  204.    loadError$ = "Can't alloc buffer"
  205.    GOTO Lcleanup
  206. END IF
  207.  
  208. inbuf& = mybuf&
  209. cbuf& = mybuf& + 120
  210. ctab& = mybuf& + 240
  211.  
  212.  
  213. REM - Should read  FORMnnnnACBM
  214. rLen& = xRead&(fHandle&,inbuf&,12)
  215. tt$ = ""
  216. FOR kk = 8 TO 11
  217.    tt% = PEEK(inbuf& + kk)
  218.    tt$ = tt$ + CHR$(tt%)
  219. NEXT
  220.  
  221. IF tt$ <> "ACBM" THEN 
  222.    loadError$ = "Not an ACBM pic file"
  223.    GOTO Lcleanup
  224. END IF
  225.  
  226. REM - Read ACBM chunks
  227.  
  228. ChunkLoop:
  229. REM - Get Chunk name/length
  230.  rLen& = xRead&(fHandle&,inbuf&,8)
  231.  icLen& = PEEKL(inbuf& + 4)
  232.  tt$ = ""
  233.  FOR kk = 0 TO 3
  234.     tt% = PEEK(inbuf& + kk)
  235.     tt$ = tt$ + CHR$(tt%)
  236.  NEXT   
  237.     
  238. IF tt$ = "BMHD" THEN  'BitMap header 
  239.    foundBMHD = 1
  240.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  241.    iWidth%  = PEEKW(inbuf&)
  242.    iHeight% = PEEKW(inbuf& + 2)
  243.    iDepth%  = PEEK(inbuf& + 8)  
  244.    iCompr%  = PEEK(inbuf& + 10)
  245.    scrWidth%  = PEEKW(inbuf& + 16)
  246.    scrHeight% = PEEKW(inbuf& + 18)
  247.  
  248.    iRowBytes% = iWidth% /8
  249.    scrRowBytes% = scrWidth% / 8
  250.    nColors%  = 2^(iDepth%)
  251.  
  252.    REM - Enough free ram to display ?
  253.    AvailRam& = FRE(-1)
  254.    NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
  255.    IF AvailRam& < NeededRam& THEN
  256.       loadError$ = "Not enough free ram."
  257.       GOTO Lcleanup
  258.    END IF
  259.  
  260.    kk = 1
  261.    IF scrWidth% > 320 THEN kk = kk + 1
  262.    IF scrHeight% > 200  THEN kk = kk + 2
  263.  
  264.    REM - Get addresses of structures
  265.    GOSUB GetScrAddrs
  266.  
  267.    REM - Black out screen
  268.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  269.  
  270.  
  271. ELSEIF tt$ = "CMAP" THEN  'ColorMap
  272.    foundCMAP = 1
  273.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  274.  
  275.    REM - Build Color Table
  276.    FOR kk = 0 TO nColors% - 1
  277.       red% = PEEK(cbuf&+(kk*3))
  278.       gre% = PEEK(cbuf&+(kk*3)+1)
  279.       blu% = PEEK(cbuf&+(kk*3)+2)
  280.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  281.       POKEW(ctab&+(2*kk)),regTemp%
  282.    NEXT
  283.  
  284.  
  285. ELSEIF tt$ = "CAMG" THEN 'Amiga ViewPort Modes
  286.    foundCAMG = 1
  287.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  288.    camgModes& = PEEKL(inbuf&)
  289.  
  290. ELSEIF tt$ = "ABIT" THEN  'Contiguous BitMap 
  291.    foundABIT = 1
  292.  
  293.    REM - This only handles full size BitMaps, not brushes
  294.    REM - Very fast - reads in entire BitPlanes
  295.    plSize& = (scrWidth%/8) * scrHeight%
  296.    FOR pp = 0 TO iDepth% -1
  297.       rLen& = xRead&(fHandle&,bPlane&(pp),plSize&)   
  298.    NEXT
  299.  
  300.  
  301. ELSE 
  302.    REM - Reading unknown chunk  
  303.    FOR kk = 1 TO icLen&
  304.       rLen& = xRead&(fHandle&,inbuf&,1)
  305.    NEXT
  306.    REM - If odd length, read 1 more byte
  307.    IF (icLen& OR 1) = icLen& THEN 
  308.       rLen& = xRead&(fHandle&,inbuf&,1)
  309.    END IF
  310.       
  311. END IF
  312. PALETTE 1,0,0,0
  313.  
  314. REM - Done if got all chunks 
  315. IF foundBMHD AND foundCMAP AND foundABIT THEN
  316.    GOTO GoodLoad
  317. END IF
  318.  
  319. REM - Good read, get next chunk
  320. IF rLen& > 0 THEN GOTO ChunkLoop
  321.  
  322. IF rLen& < 0 THEN  'Read error
  323.    loadError$ = "Read error"
  324.    GOTO Lcleanup
  325. END IF   
  326.  
  327. REM - rLen& = 0 means EOF
  328. IF (foundBMHD=0) OR (foundABIT=0) OR (foundCMAP=0) THEN
  329.    loadError$ = "Needed ILBM chunks not found"
  330.    GOTO Lcleanup
  331. END IF
  332.  
  333.  
  334. GoodLoad:
  335. loadError$ =""
  336.  
  337. REM  Load proper Colors
  338. IF foundCMAP THEN 
  339.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  340.    PALETTE 1,.23,0,0
  341. END IF
  342.  
  343. Lcleanup:
  344. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  345. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  346. PALETTE 30,1,.9,.7:PALETTE 31,.3,.1,0
  347. RETURN
  348.  
  349.  
  350. GetScrAddrs:
  351. REM - Get addresses of screen structures
  352.    sWindow&   = WINDOW(7)
  353.    sScreen&   = PEEKL(sWindow& + 46)
  354.    sViewPort& = sScreen& + 44
  355.    sRastPort& = sScreen& + 84
  356.    sColorMap& = PEEKL(sViewPort& + 4)
  357.    colorTab&  = PEEKL(sColorMap& + 4)
  358.    sBitMap&   = PEEKL(sRastPort& + 4)
  359.  
  360.    REM - Get screen parameters
  361.    scrWidth%  = PEEKW(sScreen& + 12)
  362.    scrHeight% = PEEKW(sScreen& + 14)
  363.    scrDepth%  = PEEK(sBitMap& + 5)
  364.    nColors%   = 2^scrDepth%
  365.  
  366.    REM - Get addresses of Bit Planes 
  367.    FOR kk = 0 TO scrDepth% - 1
  368.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  369.    NEXT
  370. RETURN
  371.  
  372. fini:
  373. OBJECT.OFF 1
  374. PALETTE 16,.2,0,.3
  375. LINE(105,9)-(2,28),16,bf
  376. LINE(2,187)-(320,28),16,bf
  377. LINE(194,9)-(320,28),16,bf
  378. LINE(20,28)-(290,130),8,bf
  379. COLOR 3,8
  380. LOCATE 5,5:PRINT" DISK  MAGAZINE FOR THE AMIGA "
  381. CIRCLE(270,32),4,3:LINE(270,31)-(270,33),3:LINE(269,31)-(271,31),3
  382. LOCATE 8,9:PRINT "CONGRATULATIONS"
  383. LOCATE 10,9:PRINT"ON FINDING YOUR WAY"
  384. LOCATE 11,9:PRINT"THROUGH THE PIPEWORKS."
  385. LOCATE 13,9:PRINT"You are a truly"
  386. LOCATE 14,9:PRINT"persistent person."
  387. FIN=1:D!=3.6:GOTO 1
  388.  
  389. dun2:
  390. COLOR 8,16:LOCATE 20,8:PRINT"   Perhaps next time.   "
  391. dun:
  392. LOCATE 21,8:PRINT " Press any key to exit. "
  393. 100 a$=INKEY$:IF a$="" THEN GOTO 100
  394. WINDOW CLOSE 2
  395. SCREEN CLOSE 2
  396. SYSTEM
  397.